*
* $Id$
*
* $Log: dzare1.F,v $
* Revision 1.1.1.1  2002/07/24 15:56:28  rdm
* initial import into CVS
*
* Revision 1.1.1.1  2002/06/16 15:18:48  hristov
* Separate distribution  of Geant3
*
* Revision 1.2  2002/05/19 18:08:01  hristov
* Changes needed by ICC/IFC compiler (Intel)
*
* Revision 1.1.1.1  1999/05/18 15:55:22  fca
* AliRoot sources
*
* Revision 1.2  1996/04/24 17:26:00  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.1.1.1  1996/03/06 10:47:06  mclareni
* Zebra
*
*
*-----------------------------------------------------------
#include "zebra/pilot.h"
#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
#include "zebra/debugvf1.inc"
#endif
      SUBROUTINE DZARE1  (CHTEXT,CLA,LLA,CHOPT)
      SAVE CLATYP
#include "zebra/mqsys.inc"
#include "zebra/qequ.inc"
#include "zebra/mzcn.inc"
#include "zebra/zbcdch.inc"
#include "zebra/zbcdk.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/dzc1.inc"
#include "zebra/questparq.inc"
#include "zebra/storparq.inc"
      CHARACTER *(*) CLA,CHOPT,CHTEXT
      INTEGER ILANAM(2)

      CHARACTER CHROUT*(*),CHSTAK*6,   CLATYP(0:1)*9, CLA8*8, CAKTIV*8
      PARAMETER (CHROUT = 'DZARE1')
      DATA      CLATYP               /'PERMANENT','TEMPORARY'/

#include "zebra/q_jbit.inc"
#include "zebra/q_jbyt.inc"

#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
#include "zebra/debugvf2.inc"
#endif


      CHSTAK          = CQSTAK(MCQSIQ:)
      CQSTAK(MCQSIQ:) = CHROUT

      IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) THEN
          IQUEST(1) = 0
                                                           GO TO 999
      ENDIF

      LSYSB  = LQSYSS(KQT+MSYLAQ)
      CALL MZCHLS(NCHEKQ,LSYSB)
      IF (IQFOUL.NE.0)  THEN
          WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
          CALL DZTEXT(MARE1Q,CHTEXT,0)
                                                           GO TO 999
      ENDIF


      NWTAB  = IQ(KQS+LSYSB+MLAUSQ)
      IF(NWTAB.LE.1)                   THEN
          WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
          CALL DZTEXT(MARE2Q,CHTEXT,0)
                                                           GO TO 999
      ENDIF

      IF (IFLOPT(MPOSNQ).NE.0)  THEN


          CLA8 = CLA
          CALL UCTOH (CLA8,ILANAM,4,8)
      ELSE


          LLINK = LOCF(LLA) - LQSTOR
      ENDIF


      LENTRY = LSYSB + KQS + MLAUSQ

      IFOUND = 0

      DO 100 IENTRY = 1,(NWTAB-1)/NLAENQ


          IF (IFLOPT(MPOSNQ).NE.0) THEN
              IF(CLA.NE.' ')   THEN
                  IF (ILANAM(1).NE.IQ(LENTRY+MLAN1Q) .OR.
     X                ILANAM(2).NE.IQ(LENTRY+MLAN2Q)  )    GO TO 100
              ELSE
                  IF(IENTRY.LE.2)                          GO TO 100
              ENDIF

          ELSE


              IF (LLINK.LT.IQ(LENTRY+MLAADQ) .OR.
     X            LLINK.GT.IQ(LENTRY+MLALTQ)       )       GO TO 100

          ENDIF


          LLAAR1 = IQ(LENTRY+MLAADQ)
          LLAARL = IQ(LENTRY+MLALTQ)
          NLANS  = IQ(LENTRY+MLANSQ)
          JTEMP  = JBIT(NLANS,JLATMQ)
          NTEMP  = NLATMQ*JTEMP
          NLANS  = JBYT(NLANS,JLANSQ,NLANSQ)-NTEMP
          IF(JTEMP.EQ.0.OR.
     +     (JTEMP.EQ.1.AND.LQ(KQS+LLAAR1+MLACTQ-1).NE.0))          THEN
              CAKTIV = '  ACTIVE'
          ELSE
              CAKTIV = 'INACTIVE'
          ENDIF


          DO 50 I = NTEMP,NLANS-1
              LS  = LQ(KQS+LLAAR1+I)
              IF (LS.EQ.0)                                 GO TO 50
              CALL MZCHLS(NCHEKQ,LS)
              ID     = IQID
              IF (JBIT(IQ(KQS+LS),IQDROP).EQ.1)            GO TO 50
              IF (IQFOUL.EQ.0) THEN
                  LUP    = LQLUP(KQS+LS)
                  IF (LUP.EQ.0)                            GO TO 40
                  CALL MZCHLS(NCHEKQ,LUP)
                  IF (IQFOUL.NE.0) THEN
                      WRITE(CQINFO,
     X                 '(2A4,''/'',I5,''= '',A4,2I10)')
     X                 IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
     X                 I+1,ID,LS,LUP
                      CALL DZTEXT(MARE3Q,CDUMMQ,0)
                  ENDIF
   40             LORIG  = LQLORG(KQS+LS)
                  IF (LORIG.EQ.0)                          GO TO 50
                  IF(LORIG.LT.IQTABV(KQT+13).OR.LORIG.GT.IQTABV(KQT+14))
     X                  THEN
                      WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
     X                 IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
     X                 I+1,ID,LS,LORIG
                      CALL DZTEXT(MARE4Q,CDUMMQ,0)
                  ELSEIF (LQ(KQS+LORIG).NE.LS) THEN
                      WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
     X                 IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
     X                 I+1,ID,LS,LORIG
                      CALL DZTEXT(MARE4Q,CDUMMQ,0)
                  ENDIF
                  IF (IQND.LT.NQDCUT.AND.IFLOPT(MPOSTQ).NE.0)
     X             CALL SBIT1 (IQ(KQS+LS),IQCRIT)
              ELSE
                  WRITE(CQINFO,'(2A4,''/'',I5,''='',I10)')
     X             IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),I+1,LS
                  CALL DZTEXT(MARE5Q,CDUMMQ,0)
              ENDIF
   50     CONTINUE

          IF (IFLOPT(MPOSQQ).EQ.0) THEN
             IF (CHTEXT.NE.CDUMMQ)                                 THEN
                 CQMAP(1)      = ' '
                 CQMAP(2)      = ' DZAREA -- '
                 CQMAP(2)(12:) = CHTEXT
                 WRITE(CQMAP(2)(80:),'('' -- Dump of link area '',2A4,
     W           '' Options: '',A)')
     W           IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),CHOPT
                 CALL DZTEXT(0,CDUMMQ,2)
             ENDIF

             CQMAP(1) = ' '
#if !defined(CERNLIB_OCTMAP)
             WRITE(CQMAP(2),
     W       '('' This '',A9,'' LINK AREA is at absolute address '',Z8,
     W       '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)'      )
     W        CLATYP(JTEMP),(LLAAR1+LQSTOR)
#else
             WRITE(CQMAP(2),
     W       '('' This '',A9,'' LINK AREA is at absolute address '',O11,
     W       '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)'      )
     W        CLATYP(JTEMP),(LLAAR1+LQSTOR)
#endif
#if !defined(CERNLIB_WORDMAP)
     W       *4
#endif
     W        ,LLAARL-LLAAR1-NTEMP,NLANS,CAKTIV
             CALL DZTEXT(0,CDUMMQ,2)
             CALL DZTEXT(1,CDUMMQ,1)


             LBASE  = LLAAR1 + NTEMP - 1
             IBASE  = 0
             NDW    = LLAARL - LLAAR1  - NTEMP
             JDFD   = NDW    + 1

             CALL DZDATA(CDUMMQ)

             IFOUND = 1
             IF (IFLOPT(MPOSNQ).NE.0) THEN
                 IF (CLA.NE.' ')                           GO TO 999
             ELSE
                                                           GO TO 999
             ENDIF
          ELSE
              IQUEST(10) = IENTRY
              IQUEST(11) = IQ(LENTRY+MLAN1Q)
              IQUEST(12) = IQ(LENTRY+MLAN2Q)
              IQUEST(13) = LLAAR1
              IQUEST(14) = LLAAR1 + NLANS
              IQUEST(15) = LLAARL
              IQUEST(16) = NLANS
              IQUEST(17) = LLAARL-LLAAR1
              IQUEST(18) = JTEMP
              IQUEST(19) = LQ(KQS+LLAAR1+MLACTQ-1)
                                                           GO TO 999
             ENDIF
  100     LENTRY = LENTRY + NLAENQ

      IF (IFOUND.EQ.0)           THEN
          IF (IFLOPT(MPOSQQ).EQ.0) THEN
             IF (IFLOPT(MPOSNQ).NE.0) THEN
                 WRITE(CQINFO,'(A)') CLA8
                 CALL DZTEXT(MARE6Q,CHTEXT,0)
             ELSE
                 WRITE(CQINFO,'(I8)') LLINK
                 CALL DZTEXT(MARE7Q,CHTEXT,0)
             ENDIF
          ELSE
             IQUEST(10) = 0
          ENDIF
      ENDIF

  999 CQSTAK(MCQSIQ:) = CHSTAK
C      RETURN
      END
